home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 2 / AACD 2.iso / AACD / Programming / fpc / units / dos.pp < prev    next >
Text File  |  1998-09-21  |  51KB  |  1,782 lines
  1. {
  2.     $Id: dos.pp,v 1.9 1998/09/14 20:20:57 carl Exp $
  3.     This file is part of the Free Pascal run time library.
  4.     Copyright (c) 1998 by Nils Sjoholm and Carl Eric Codere
  5.     members of the Free Pascal development team
  6.       Date conversion routine taken from SWAG
  7.  
  8.     See the file COPYING.FPC, included in this distribution,
  9.     for details about the copyright.
  10.  
  11.     This program is distributed in the hope that it will be useful,
  12.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  13.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  14.  
  15.  **********************************************************************}
  16.  
  17. Unit Dos;
  18.  
  19.  
  20. {--------------------------------------------------------------------}
  21. { LEFT TO DO:                                                        }
  22. {--------------------------------------------------------------------}
  23. { o DiskFree / Disksize don't work as expected                       }
  24. { o Implement SetDate and SetTime                                    }
  25. { o Implement EnvCount,EnvStr                                        }
  26. { o FindFirst should only work with correct attributes               }
  27. {--------------------------------------------------------------------}
  28.  
  29.  
  30.  
  31.  
  32. Interface
  33.  
  34. {$I os.inc}
  35.  
  36.  
  37. Const
  38.   {Bitmasks for CPU Flags}
  39.   fcarry     = $0001;
  40.   fparity    = $0004;
  41.   fauxiliary = $0010;
  42.   fzero      = $0040;
  43.   fsign      = $0080;
  44.   foverflow  = $0800;
  45.  
  46.   {Bitmasks for file attribute}
  47.   readonly  = $01;
  48.   hidden    = $02;
  49.   sysfile   = $04;
  50.   volumeid  = $08;
  51.   directory = $10;
  52.   archive   = $20;
  53.   anyfile   = $3F;
  54.  
  55.   {File Status}
  56.   fmclosed = $D7B0;
  57.   fminput  = $D7B1;
  58.   fmoutput = $D7B2;
  59.   fminout  = $D7B3;
  60.  
  61.  
  62. Type
  63.   ComStr  = String[255];  { size increased to be more compatible with Unix}
  64.   PathStr = String[255];  { size increased to be more compatible with Unix}
  65.   DirStr  = String[255];  { size increased to be more compatible with Unix}
  66.   NameStr = String[255];  { size increased to be more compatible with Unix}
  67.   ExtStr  = String[255];  { size increased to be more compatible with Unix}
  68.  
  69.  
  70.  
  71. {
  72.   filerec.inc contains the definition of the filerec.
  73.   textrec.inc contains the definition of the textrec.
  74.   It is in a separate file to make it available in other units without
  75.   having to use the DOS unit for it.
  76. }
  77. {$i filerec.inc}
  78. {$i textrec.inc}
  79.  
  80.  
  81. Type
  82.  
  83.   SearchRec = Packed Record
  84.     { watch out this is correctly aligned for all processors }
  85.     { don't modify.                                          }
  86.     { Replacement for Fill }
  87. {0} AnchorPtr : Pointer;    { Pointer to the Anchorpath structure }
  88. {4} Fill: Array[1..15] of Byte; {future use}
  89.     {End of replacement for fill}
  90.     Attr : BYTE;        {attribute of found file}
  91.     Time : LongInt;     {last modify date of found file}
  92.     Size : LongInt;     {file size of found file}
  93.     Name : String[255]; {name of found file}
  94.   End;
  95.  
  96.  
  97.   DateTime = packed record
  98.     Year: Word;
  99.     Month: Word;
  100.     Day: Word;
  101.     Hour: Word;
  102.     Min: Word;
  103.     Sec: word;
  104.   End;
  105.  
  106.  
  107.  
  108. Var
  109.   DosError : integer;
  110.  
  111. {Interrupt}
  112. {Procedure Intr(intno: byte; var regs: registers);
  113. Procedure MSDos(var regs: registers);}
  114.  
  115. {Info/Date/Time}
  116. Function  DosVersion: Word;
  117. Procedure GetDate(var year, month, mday, wday: word);
  118. Procedure GetTime(var hour, minute, second, sec100: word);
  119. procedure SetDate(year,month,day: word);
  120. Procedure SetTime(hour,minute,second,sec100: word);
  121. Procedure UnpackTime(p: longint; var t: datetime);
  122. Procedure PackTime(var t: datetime; var p: longint);
  123.  
  124. {Exec}
  125. Procedure Exec(const path: pathstr; const comline: comstr);
  126. Function  DosExitCode: word;
  127.  
  128. {Disk}
  129. Function  DiskFree(drive: byte) : longint;
  130. Function  DiskSize(drive: byte) : longint;
  131. Procedure FindFirst(path: pathstr; attr: word; var f: searchRec);
  132. Procedure FindNext(var f: searchRec);
  133. Procedure FindClose(Var f: SearchRec);
  134.  
  135. {File}
  136. Procedure GetFAttr(var f; var attr: word);
  137. Procedure GetFTime(var f; var time: longint);
  138. Function  FSearch(path: pathstr; dirlist: string): pathstr;
  139. Function  FExpand(path: pathstr): pathstr;
  140. Procedure FSplit(path: pathstr; var dir: dirstr; var name: namestr; var ext: extstr);
  141.  
  142. {Environment}
  143. Function  EnvCount: longint;
  144. Function  EnvStr(index: integer): string;
  145. Function  GetEnv(envvar: string): string;
  146.  
  147. {Misc}
  148. Procedure SetFAttr(var f; attr: word);
  149. Procedure SetFTime(var f; time: longint);
  150. Procedure GetCBreak(var breakvalue: boolean);
  151. Procedure SetCBreak(breakvalue: boolean);
  152. Procedure GetVerify(var verify: boolean);
  153. Procedure SetVerify(verify: boolean);
  154.  
  155. {Do Nothing Functions}
  156. Procedure SwapVectors;
  157. Procedure GetIntVec(intno: byte; var vector: pointer);
  158. Procedure SetIntVec(intno: byte; vector: pointer);
  159. Procedure Keep(exitcode: word);
  160.  
  161. implementation
  162.  
  163. const
  164.   DaysPerMonth :  Array[1..12] of ShortInt =
  165. (031,028,031,030,031,030,031,031,030,031,030,031);
  166.   DaysPerYear  :  Array[1..12] of Integer  =
  167. (031,059,090,120,151,181,212,243,273,304,334,365);
  168.   DaysPerLeapYear :    Array[1..12] of Integer  =
  169. (031,060,091,121,152,182,213,244,274,305,335,366);
  170.   SecsPerYear      : LongInt  = 31536000;
  171.   SecsPerLeapYear  : LongInt  = 31622400;
  172.   SecsPerDay       : LongInt  = 86400;
  173.   SecsPerHour      : Integer  = 3600;
  174.   SecsPerMinute    : ShortInt = 60;
  175.   TICKSPERSECOND    = 50;
  176.  
  177.  
  178.  
  179. Type
  180.     pClockData = ^tClockData;
  181.     tClockData = packed Record
  182.       sec   : Word;
  183.       min   : Word;
  184.       hour  : Word;
  185.       mday  : Word;
  186.       month : Word;
  187.       year  : Word;
  188.       wday  : Word;
  189.     END;
  190.  
  191.     BPTR     = Longint;
  192.     BSTR     = Longint;
  193.  
  194.   pMinNode = ^tMinNode;
  195.   tMinNode = Packed Record
  196.     mln_Succ,
  197.     mln_Pred  : pMinNode;
  198.   End;
  199.  
  200.  
  201.     pMinList = ^tMinList;
  202.     tMinList = Packed record
  203.     mlh_Head        : pMinNode;
  204.     mlh_Tail        : pMinNode;
  205.     mlh_TailPred    : pMinNode;
  206.     end;
  207. { *  List Node Structure.  Each member in a list starts with a Node * }
  208.  
  209.   pNode = ^tNode;
  210.   tNode = Packed Record
  211.     ln_Succ,                { * Pointer to next (successor) * }
  212.     ln_Pred  : pNode;       { * Pointer to previous (predecessor) * }
  213.     ln_Type  : Byte;
  214.     ln_Pri   : Shortint;        { * Priority, for sorting * }
  215.     ln_Name  : PCHAR;       { * ID string, null terminated * }
  216.   End;  { * Note: Integer aligned * }
  217.  
  218.  
  219.  
  220.     pList = ^tList;
  221.     tList = Packed record
  222.     lh_Head     : pNode;
  223.     lh_Tail     : pNode;
  224.     lh_TailPred : pNode;
  225.     lh_Type     : Byte;
  226.     l_pad       : Byte;
  227.     end;
  228.  
  229.  
  230.    pMsgPort = ^tMsgPort;
  231.     tMsgPort = Packed record
  232.     mp_Node     : tNode;
  233.     mp_Flags    : Byte;
  234.     mp_SigBit   : Byte;     { signal bit number    }
  235.     mp_SigTask  : Pointer;   { task to be signalled (TaskPtr) }
  236.     mp_MsgList  : tList;     { message linked list  }
  237.     end;
  238.  
  239.  
  240.   pTask = ^tTask;
  241.     tTask = Packed record
  242.         tc_Node         : tNode;
  243.         tc_Flags        : Byte;
  244.         tc_State        : Byte;
  245.         tc_IDNestCnt    : Shortint;         { intr disabled nesting         }
  246.         tc_TDNestCnt    : Shortint;         { task disabled nesting         }
  247.         tc_SigAlloc     : longint;        { sigs allocated                }
  248.         tc_SigWait      : longint;         { sigs we are waiting for       }
  249.         tc_SigRecvd     : longint;         { sigs we have received         }
  250.         tc_SigExcept    : longint;         { sigs we will take excepts for }
  251.         tc_TrapAlloc    : Word;        { traps allocated               }
  252.         tc_TrapAble     : Word;        { traps enabled                 }
  253.         tc_ExceptData   : Pointer;      { points to except data         }
  254.         tc_ExceptCode   : Pointer;      { points to except code         }
  255.         tc_TrapData     : Pointer;      { points to trap data           }
  256.         tc_TrapCode     : Pointer;      { points to trap code           }
  257.         tc_SPReg        : Pointer;      { stack pointer                 }
  258.         tc_SPLower      : Pointer;      { stack lower bound             }
  259.         tc_SPUpper      : Pointer;      { stack upper bound + 2         }
  260.         tc_Switch       : Pointer;      { task losing CPU               }
  261.         tc_Launch       : Pointer;      { task getting CPU              }
  262.         tc_MemEntry     : tList;        { allocated memory              }
  263.         tc_UserData     : Pointer;      { per task data                 }
  264.     end;
  265.  
  266.  
  267.  
  268.     TDateStamp = packed record
  269.         ds_Days         : Longint;      { Number of days since Jan. 1, 1978 }
  270.         ds_Minute       : Longint;      { Number of minutes past midnight }
  271.         ds_Tick         : Longint;      { Number of ticks past minute }
  272.     end;
  273.     PDateStamp = ^TDateStamp;
  274.  
  275.  
  276.  
  277. { Returned by Examine() and ExInfo(), must be on a 4 byte boundary }
  278.  
  279.     PFileInfoBlock = ^TfileInfoBlock;
  280.     TFileInfoBlock = packed record
  281.         fib_DiskKey     : Longint;
  282.         fib_DirEntryType : Longint;
  283.                         { Type of Directory. If < 0, then a plain file.
  284.                           If > 0 a directory }
  285.         fib_FileName    : Array [0..107] of Char;
  286.                         { Null terminated. Max 30 chars used for now }
  287.         fib_Protection  : Longint;
  288.                         { bit mask of protection, rwxd are 3-0. }
  289.         fib_EntryType   : Longint;
  290.         fib_Size        : Longint;      { Number of bytes in file }
  291.         fib_NumBlocks   : Longint;      { Number of blocks in file }
  292.         fib_Date        : TDateStamp; { Date file last changed }
  293.         fib_Comment     : Array [0..79] of Char;
  294.                         { Null terminated comment associated with file }
  295.         fib_Reserved    : Array [0..35] of Char;
  296.     end;
  297.  
  298. { returned by Info(), must be on a 4 byte boundary }
  299.  
  300.     pInfoData = ^tInfoData;
  301.     tInfoData = packed record
  302.         id_NumSoftErrors        : Longint;      { number of soft errors on disk }
  303.         id_UnitNumber           : Longint;      { Which unit disk is (was) mounted on }
  304.         id_DiskState            : Longint;      { See defines below }
  305.         id_NumBlocks            : Longint;      { Number of blocks on disk }
  306.         id_NumBlocksUsed        : Longint;      { Number of block in use }
  307.         id_BytesPerBlock        : Longint;
  308.         id_DiskType             : Longint;      { Disk Type code }
  309.         id_VolumeNode           : BPTR;         { BCPL pointer to volume node }
  310.         id_InUse                : Longint;      { Flag, zero if not in use }
  311.     end;
  312.  
  313.  
  314. { ------ Library Base Structure ---------------------------------- }
  315. {  Also used for Devices and some Resources  }
  316.  
  317.     pLibrary = ^tLibrary;
  318.     tLibrary = packed record
  319.         lib_Node     : tNode;
  320.         lib_Flags,
  321.         lib_pad      : Byte;
  322.         lib_NegSize,            {  number of bytes before library  }
  323.         lib_PosSize,            {  number of bytes after library  }
  324.         lib_Version,            {  major  }
  325.         lib_Revision : Word;    {  minor  }
  326.         lib_IdString : PCHAR;   {  ASCII identification  }
  327.         lib_Sum      : LONGINT; {  the checksum itself  }
  328.         lib_OpenCnt  : Word;    {  number of current opens  }
  329.     end;                {  * Warning: size is not a longword multiple ! * }
  330.  
  331.        pAChain = ^tAChain;
  332.        tAChain = packed record
  333.         an_Child,
  334.         an_Parent   : pAChain;
  335.         an_Lock     : BPTR;
  336.         an_Info     : tFileInfoBlock;
  337.         an_Flags    : Shortint;
  338.         an_String   : Array[0..0] of Char;   { FIX!! }
  339.        END;
  340.  
  341.  
  342.        pAnchorPath = ^tAnchorPath;
  343.        tAnchorPath = packed record
  344.         case integer of
  345.         0 : (
  346.         ap_First      : pAChain;
  347.         ap_Last       : pAChain;
  348.         );
  349.         1 : (
  350.         ap_Base,                    { pointer to first anchor }
  351.         ap_Current    : pAChain;    { pointer to last anchor }
  352.         ap_BreakBits,               { Bits we want to break on }
  353.         ap_FoundBreak : Longint;    { Bits we broke on. Also returns ERROR_BREAK }
  354.         ap_Flags      : Shortint;       { New use for extra Integer. }
  355.         ap_Reserved   : Shortint;
  356.         ap_Strlen     : Integer;       { This is what ap_Length used to be }
  357.         ap_Info       : tFileInfoBlock;
  358.         ap_Buf        : Array[0..0] of Char;     { Buffer for path name, allocated by user !! }
  359.         { FIX! }
  360.         );
  361.        END;
  362.  
  363.  
  364.     pCommandLineInterface = ^TCommandLineInterface;
  365.     TCommandLineInterface = packed record
  366.       cli_result2     : longint;    {* Value of IoErr from last command   *}
  367.       cli_SetName     : BSTR;       {* Name of current directory             *}
  368.       cli_CommandDir  : BPTR;       {* Head of the path locklist             *}
  369.       cli_ReturnCode  : longint;    {* Return code from last command          *}
  370.       cli_CommandName : BSTR;       {* Name of current command              *}
  371.       cli_FailLevel   : longint;    {* Fail level (set by FAILAT)            *}
  372.       cli_Prompt      : BSTR;       {* Current prompt (set by PROMPT)     *}
  373.       cli_StandardInput: BPTR;      {* Default (terminal) CLI input       *}
  374.       cli_CurrentInput : BPTR;      {* Current CLI input                       *}
  375.       cli_CommandFile  : BSTR;      {* Name of EXECUTE command file       *}
  376.       cli_Interactive  : longint;   {* Boolean; True if prompts required  *}
  377.       cli_Background   : longint;   {* Boolean; True if CLI created by RUN*}
  378.       cli_CurrentOutput: BPTR;      {* Current CLI output                   *}
  379.       cli_DefautlStack : longint;   {* Stack size to be obtained in long words *}
  380.       cli_StandardOutput : BPTR;    {* Default (terminal) CLI output          *}
  381.       cli_Module       : BPTR;      {* SegList of currently loaded command*}
  382.     END;
  383.  
  384.     {    structure used for multi-directory assigns. AllocVec()ed. }
  385.  
  386.        pAssignList = ^tAssignList;
  387.        tAssignList = packed record
  388.         al_Next : pAssignList;
  389.         al_Lock : BPTR;
  390.        END;
  391.  
  392.    pDosList = ^tDosList;
  393.    tDosList = packed record
  394.     dol_Next            : BPTR;           {    bptr to next device on list }
  395.     dol_Type            : Longint;        {    see DLT below }
  396.     dol_Task            : pMsgPort;       {    ptr to handler task }
  397.     dol_Lock            : BPTR;
  398.     case integer of
  399.     0 : (
  400.         dol_Handler : record
  401.           dol_Handler    : BSTR;      {    file name to load IF seglist is null }
  402.           dol_StackSize,              {    stacksize to use when starting process }
  403.           dol_Priority,               {    task priority when starting process }
  404.           dol_Startup    : Longint;   {    startup msg: FileSysStartupMsg for disks }
  405.           dol_SegList,                {    already loaded code for new task }
  406.           dol_GlobVec    : BPTR;      {    BCPL global vector to use when starting
  407.                                  * a process. -1 indicates a C/Assembler
  408.                                  * program. }
  409.         end;
  410.     );
  411.     1 : (
  412.         dol_Volume       : record
  413.           dol_VolumeDate : tDateStamp; {    creation date }
  414.           dol_LockList   : BPTR;       {    outstanding locks }
  415.           dol_DiskType   : Longint;    {    'DOS', etc }
  416.         END;
  417.     );
  418.     2 : (
  419.         dol_assign       :  record
  420.           dol_AssignName : PChar;         {    name for non-OR-late-binding assign }
  421.           dol_List       : pAssignList;   {    for multi-directory assigns (regular) }
  422.          END;
  423.     dol_Name            : BSTR;           {    bptr to bcpl name }
  424.     );
  425.    END;
  426.  
  427.  
  428.     TProcess = packed record
  429.         pr_Task         : TTask;
  430.         pr_MsgPort      : TMsgPort;      { This is BPTR address from DOS functions  }
  431. {126}   pr_Pad          : Word;         { Remaining variables on 4 byte boundaries }
  432. {128}   pr_SegList      : Pointer;      { Array of seg lists used by this process  }
  433. {132}   pr_StackSize    : Longint;      { Size of process stack in bytes            }
  434. {136}   pr_GlobVec      : Pointer;      { Global vector for this process (BCPL)    }
  435. {140}   pr_TaskNum      : Longint;      { CLI task number of zero if not a CLI      }
  436. {144}   pr_StackBase    : BPTR;         { Ptr to high memory end of process stack  }
  437. {148}   pr_Result2      : Longint;      { Value of secondary result from last call }
  438. {152}   pr_CurrentDir   : BPTR;         { Lock associated with current directory   }
  439. {156}   pr_CIS          : BPTR;         { Current CLI Input Stream                  }
  440. {160}   pr_COS          : BPTR;         { Current CLI Output Stream                 }
  441. {164}   pr_ConsoleTask  : Pointer;      { Console handler process for current window}
  442. {168}   pr_FileSystemTask : Pointer;    { File handler process for current drive   }
  443. {172}   pr_CLI          : BPTR;         { pointer to ConsoleLineInterpreter         }
  444.         pr_ReturnAddr   : Pointer;      { pointer to previous stack frame           }
  445.         pr_PktWait      : Pointer;      { Function to be called when awaiting msg  }
  446.         pr_WindowPtr    : Pointer;      { Window for error printing }
  447.         { following definitions are new with 2.0 }
  448.         pr_HomeDir      : BPTR;         { Home directory of executing program      }
  449.         pr_Flags        : Longint;      { flags telling dos about process          }
  450.         pr_ExitCode     : Pointer;      { code to call on exit of program OR NULL  }
  451.         pr_ExitData     : Longint;      { Passed as an argument to pr_ExitCode.    }
  452.         pr_Arguments    : PChar;        { Arguments passed to the process at start }
  453.         pr_LocalVars    : TMinList;      { Local environment variables             }
  454.         pr_ShellPrivate : Longint;      { for the use of the current shell         }
  455.         pr_CES          : BPTR;         { Error stream - IF NULL, use pr_COS       }
  456.     end;
  457.     PProcess = ^TProcess;
  458.  
  459.  
  460. CONST
  461.     { DOS Lib Offsets }
  462.     _LVOMatchFirst = -822;
  463.     _LVOMatchNext  = -828;
  464.     _LVOMatchEnd   = -834;
  465.     _LVOCli        = -492;
  466.     _LVOExecute    = -222;
  467.     _LVOSystemTagList = -606;
  468.     _LVOSetFileDate = -396;
  469.  
  470.     LDF_READ   = 1;
  471.     LDF_DEVICES = 4;
  472.  
  473.     ERROR_NO_MORE_ENTRIES            = 232;
  474.     FIBF_SCRIPT         = 64;  { program is a script              }
  475.     FIBF_PURE           = 32;  { program is reentrant             }
  476.     FIBF_ARCHIVE        = 16;  { cleared whenever file is changed }
  477.     FIBF_READ           = 8;   { ignoed by old filesystem         }
  478.     FIBF_WRITE          = 4;   { ignored by old filesystem        }
  479.     FIBF_EXECUTE        = 2;   { ignored by system, used by shell }
  480.     FIBF_DELETE         = 1;   { prevent file from being deleted  }
  481.  
  482.     SHARED_LOCK         = -2;
  483.  
  484. {******************************************************************************
  485.                            --- Internal routines ---
  486. ******************************************************************************}
  487.  
  488.  
  489. procedure CurrentTime(var Seconds, Micros : Longint);
  490. Begin
  491.  asm
  492.     MOVE.L  A6,-(A7)
  493.     MOVE.L  Seconds,a0
  494.     MOVE.L  Micros,a1
  495.     MOVE.L  _IntuitionBase,A6
  496.     JSR -084(A6)
  497.     MOVE.L  (A7)+,A6
  498.  end;
  499. end;
  500.  
  501.  
  502. function Date2Amiga(date : pClockData) : Longint;
  503. Begin
  504.   asm
  505.     MOVE.L  A6,-(A7)
  506.     MOVE.L  date,a0
  507.     MOVE.L  _UtilityBase,A6
  508.     JSR -126(A6)
  509.     MOVE.L  (A7)+,A6
  510.     MOVE.L  d0,@RESULT
  511.   end;
  512. end;
  513.  
  514.  
  515. procedure Amiga2Date(amigatime : Longint;
  516.                      resultat : pClockData);
  517. Begin
  518.   asm
  519.     MOVE.L  A6,-(A7)
  520.     MOVE.L  amigatime,d0
  521.     MOVE.L  resultat,a0
  522.     MOVE.L  _UtilityBase,A6
  523.     JSR -120(A6)
  524.     MOVE.L  (A7)+,A6
  525.   end;
  526. end;
  527.  
  528. FUNCTION Examine(lock : BPTR; fileInfoBlock : pFileInfoBlock) : BOOLEAN;
  529. BEGIN
  530.   ASM
  531.     MOVE.L  A6,-(A7)
  532.     MOVE.L  lock,D1
  533.     MOVE.L  fileInfoBlock,D2
  534.     MOVEA.L _DOSBase,A6
  535.     JSR -102(A6)
  536.     MOVEA.L (A7)+,A6
  537.     TST.L   D0
  538.     BEQ.B   @end
  539.     MOVE.B  #1,D0
  540.     @end: MOVE.B  D0,@RESULT
  541.   END;
  542. END;
  543.  
  544. function Lock(const name : string;
  545.            accessmode : Longint) : BPTR;
  546. var
  547.  buffer: Array[0..255] of char;
  548. Begin
  549.   move(name[1],buffer,length(name));
  550.   buffer[length(name)]:=#0;
  551.   asm
  552.     MOVEM.L d2/a6,-(A7)
  553.     LEA     buffer,a0
  554.     MOVE.L  a0,d1
  555.     MOVE.L  accessmode,d2
  556.     MOVE.L  _DOSBase,A6
  557.     JSR -084(A6)
  558.     MOVEM.L (A7)+,d2/a6
  559.     MOVE.L  d0,@RESULT
  560.   end;
  561. end;
  562.  
  563.  
  564. procedure UnLock(lock : BPTR);
  565. Begin
  566.   asm
  567.     MOVE.L  A6,-(A7)
  568.     MOVE.L  lock,d1
  569.     MOVE.L  _DOSBase,A6
  570.     JSR -090(A6)
  571.     MOVE.L  (A7)+,A6
  572.   end;
  573. end;
  574.  
  575. FUNCTION Info(lock : BPTR; parameterBlock : pInfoData) : BOOLEAN;
  576. BEGIN
  577.   ASM
  578.     MOVE.L  A6,-(A7)
  579.     MOVE.L  lock,D1
  580.     MOVE.L  parameterBlock,D2
  581.     MOVEA.L _DOSBase,A6
  582.     JSR -114(A6)
  583.     MOVEA.L (A7)+,A6
  584.     TST.L   D0
  585.     BEQ.B   @end
  586.     MOVE.B  #1,D0
  587.     @end:
  588.      MOVE.B  D0,@RESULT
  589.   END;
  590. END;
  591.  
  592. FUNCTION NameFromLock(lock : BPTR; buffer : pCHAR; len : LONGINT) : BOOLEAN;
  593. BEGIN
  594.   ASM
  595.     MOVE.L  A6,-(A7)
  596.     MOVE.L  lock,D1
  597.     MOVE.L  buffer,D2
  598.     MOVE.L  len,D3
  599.     MOVEA.L _DOSBase,A6
  600.     JSR -402(A6)
  601.     MOVEA.L (A7)+,A6
  602.     TST.L   D0
  603.     BEQ.B   @end
  604.     MOVE.B  #1,D0
  605.     @end: MOVE.B  D0,@RESULT
  606.   END;
  607. END;
  608.  
  609. FUNCTION GetVar(name : pCHAR; buffer : pCHAR; size : LONGINT; flags : LONGINT) : LONGINT;
  610. BEGIN
  611.   ASM
  612.     MOVE.L  A6,-(A7)
  613.     MOVE.L  name,D1
  614.     MOVE.L  buffer,D2
  615.     MOVE.L  size,D3
  616.     MOVE.L  flags,D4
  617.     MOVEA.L _DOSBase,A6
  618.     JSR -906(A6)
  619.     MOVEA.L (A7)+,A6
  620.     MOVE.L  D0,@RESULT
  621.   END;
  622. END;
  623.  
  624. FUNCTION FindTask(name : pCHAR) : pTask;
  625. BEGIN
  626.   ASM
  627.     MOVE.L  A6,-(A7)
  628.     MOVEA.L name,A1
  629.     MOVEA.L _ExecBase,A6
  630.     JSR -294(A6)
  631.     MOVEA.L (A7)+,A6
  632.     MOVE.L  D0,@RESULT
  633.   END;
  634. END;
  635.  
  636. FUNCTION MatchFirst(pat : pCHAR; anchor : pAnchorPath) : LONGINT;
  637. BEGIN
  638.   ASM
  639.     MOVE.L  A6,-(A7)
  640.     MOVE.L  pat,D1
  641.     MOVE.L  anchor,D2
  642.     MOVEA.L _DOSBase,A6
  643.     JSR -822(A6)
  644.     MOVEA.L (A7)+,A6
  645.     MOVE.L  D0,@RESULT
  646.   END;
  647. END;
  648.  
  649. FUNCTION MatchNext(anchor : pAnchorPath) : LONGINT;
  650. BEGIN
  651.   ASM
  652.     MOVE.L  A6,-(A7)
  653.     MOVE.L  anchor,D1
  654.     MOVEA.L _DOSBase,A6
  655.     JSR -828(A6)
  656.     MOVEA.L (A7)+,A6
  657.     MOVE.L  D0,@RESULT
  658.   END;
  659. END;
  660.  
  661. PROCEDURE MatchEnd(anchor : pAnchorPath);
  662. BEGIN
  663.   ASM
  664.     MOVE.L  A6,-(A7)
  665.     MOVE.L  anchor,D1
  666.     MOVEA.L _DOSBase,A6
  667.     JSR -834(A6)
  668.     MOVEA.L (A7)+,A6
  669.   END;
  670. END;
  671.  
  672. FUNCTION Cli : pCommandLineInterface;
  673. BEGIN
  674.   ASM
  675.     MOVE.L  A6,-(A7)
  676.     MOVEA.L _DOSBase,A6
  677.     JSR -492(A6)
  678.     MOVEA.L (A7)+,A6
  679.     MOVE.L  D0,@RESULT
  680.   END;
  681. END;
  682.  
  683. Function _Execute(p: pchar): longint;
  684.  Begin
  685.    asm
  686.      move.l  a6,d6                 { save base pointer       }
  687.      move.l  d2,-(sp)
  688.      move.l  p,d1                  { command to execute      }
  689.      clr.l   d2                    { No TagList for command  }
  690.      move.l  _DosBase,a6
  691.      jsr     _LVOSystemTagList(a6)
  692.      move.l  (sp)+,d2
  693.      move.l  d6,a6                 { restore base pointer    }
  694.      move.l  d0,@RESULT
  695.    end;
  696. end;
  697.  
  698. FUNCTION LockDosList(flags : longint) : pDosList;
  699. BEGIN
  700.   ASM
  701.     MOVE.L  A6,-(A7)
  702.     MOVE.L  flags,D1
  703.     MOVEA.L _DOSBase,A6
  704.     JSR -654(A6)
  705.     MOVEA.L (A7)+,A6
  706.     MOVE.L  D0,@RESULT
  707.   END;
  708. END;
  709.  
  710.  
  711. PROCEDURE UnLockDosList(flags : longint);
  712. BEGIN
  713.   ASM
  714.     MOVE.L  A6,-(A7)
  715.     MOVE.L  flags,D1
  716.     MOVEA.L _DOSBase,A6
  717.     JSR -660(A6)
  718.     MOVEA.L (A7)+,A6
  719.   END;
  720. END;
  721.  
  722.  
  723. FUNCTION NextDosEntry(dlist : pDosList; flags : longint) : pDosList;
  724. BEGIN
  725.   ASM
  726.     MOVE.L  A6,-(A7)
  727.     MOVE.L  dlist,D1
  728.     MOVE.L  flags,D2
  729.     MOVEA.L _DOSBase,A6
  730.     JSR -690(A6)
  731.     MOVEA.L (A7)+,A6
  732.     MOVE.L  D0,@RESULT
  733.   END;
  734. END;
  735.  
  736.  
  737. FUNCTION BADDR(bval : BPTR): POINTER;
  738. BEGIN
  739.     BADDR := POINTER( bval shl 2);
  740. END;
  741.  
  742. function PasToC(var s: string): Pchar;
  743. var i: integer;
  744. begin
  745.     i := Length(s) + 1;
  746.     if i > 255 then
  747.     begin
  748.         Delete(s, 255, 1);      { ensure there is a spare byte }
  749.         Dec(i)
  750.     end;
  751.     s[i]     := #0;
  752.     PasToC := @s[1]
  753. end;
  754.  
  755.  
  756. Procedure AmigaToDt(SecsPast: LongInt; Var Dt: DateTime);
  757. var
  758.   cd : pClockData;
  759. Begin
  760.   New(cd);
  761.   Amiga2Date(SecsPast,cd);
  762.   Dt.sec   := cd^.sec;
  763.   Dt.min   := cd^.min;
  764.   Dt.hour  := cd^.hour;
  765.   Dt.day   := cd^.mday;
  766.   Dt.month := cd^.month;
  767.   Dt.year  := cd^.year;
  768.   Dispose(cd);
  769. End;
  770.  
  771. Function DtToAmiga(DT: DateTime): LongInt;
  772. var
  773.   cd : pClockData;
  774.   temp : Longint;
  775. Begin
  776.   New(cd);
  777.   cd^.sec   := Dt.sec;
  778.   cd^.min   := Dt.min;
  779.   cd^.hour  := Dt.hour;
  780.   cd^.mday  := Dt.day;
  781.   cd^.month := Dt.month;
  782.   cd^.year  := Dt.year;
  783.   temp := Date2Amiga(cd);
  784.   Dispose(cd);
  785.   DtToAmiga := temp;
  786. end;
  787.  
  788. Function SetProtection(const name: string; mask:longint): longint;
  789.  var
  790.   buffer : array[0..255] of char;
  791.  Begin
  792.    move(name[1],buffer,length(name));
  793.    buffer[length(name)]:=#0;
  794.    asm
  795.       move.l  a6,d6
  796.       lea     buffer,a0
  797.       move.l  a0,d1
  798.       move.l  mask,d2
  799.       move.l  _DosBase,a6
  800.       jsr     -186(a6)
  801.       move.l  d6,a6
  802.       move.l  d0,@RESULT
  803.    end;
  804.  end;
  805.  
  806.  
  807. Function IsLeapYear(Source : Word) : Boolean;
  808. Begin
  809.   If (Source Mod 4 = 0) Then
  810.     IsLeapYear := True
  811.   Else
  812.     IsLeapYear := False;
  813. End;
  814.  
  815.  
  816. Procedure Amiga2DateStamp(Date : LongInt; Var TotalDays,Minutes,Ticks: longint);
  817. { Converts a value in seconds past 1978 to a value in AMIGA DateStamp format }
  818. { Taken from SWAG and modified to work with the Amiga format - CEC           }
  819. Var
  820.   LocalDate : LongInt; Done : Boolean; X : ShortInt; TotDays : Integer;
  821.   Y: Word;
  822.   M: Word;
  823.   D: Word;
  824.   H: Word;
  825.   Min: Word;
  826.   S : Word;
  827. Begin
  828.   Y   := 1978; M := 1; D := 1; H := 0; Min := 0; S := 0;
  829.   TotalDays := 0;
  830.   Minutes := 0;
  831.   Ticks := 0;
  832.   LocalDate := Date;
  833.   Done := False;
  834.   While Not Done Do
  835.   Begin
  836.     If LocalDate >= SecsPerYear Then
  837.     Begin
  838.       Inc(Y,1);
  839.       Dec(LocalDate,SecsPerYear);
  840.       Inc(TotalDays,DaysPerYear[12]);
  841.     End
  842.     Else
  843.       Done := True;
  844.     If (IsLeapYear(Y+1)) And (LocalDate >= SecsPerLeapYear) And
  845.        (Not Done) Then
  846.     Begin
  847.       Inc(Y,1);
  848.       Dec(LocalDate,SecsPerLeapYear);
  849.       Inc(TotalDays,DaysPerLeapYear[12]);
  850.     End;
  851.   End; { END WHILE }
  852.   M := 1; D := 1;
  853.   Done := False;
  854.   TotDays := LocalDate Div SecsPerDay;
  855.   { Total number of days }
  856.   TotalDays := TotalDays + TotDays;
  857.     Dec(LocalDate,TotDays*SecsPerDay);
  858.   { Absolute hours since start of day }
  859.   H := LocalDate Div SecsPerHour;
  860.   { Convert to minutes }
  861.   Minutes := H*60;
  862.     Dec(LocalDate,(H * SecsPerHour));
  863.   { Find the remaining minutes to add }
  864.   Min := LocalDate Div SecsPerMinute;
  865.     Dec(LocalDate,(Min * SecsPerMinute));
  866.   Minutes:=Minutes+Min;
  867.   { Find the number of seconds and convert to ticks }
  868.   S := LocalDate;
  869.   Ticks:=TICKSPERSECOND*S;
  870. End;
  871.  
  872.  
  873.   Function SetFileDate(name: string; p : pDateStamp): longint;
  874.   var
  875.     buffer : array[0..255] of char;
  876.   Begin
  877.     move(name[1],buffer,length(name));
  878.     buffer[length(name)]:=#0;
  879.      asm
  880.        move.l a6,d6           { save base pointer }
  881.        move.l d2,-(sp)        { save reserved reg }
  882.        lea    buffer,a0
  883.        move.l a0,d1
  884.        move.l p,d2
  885.        move.l _DosBase,a6
  886.        jsr    _LVOSetFileDate(a6)
  887.        move.l (sp)+,d2        { restore reserved reg }
  888.        move.l d6,a6           { restore base pointer }
  889.        move.l d0,@Result
  890.      end;
  891.   end;
  892.  
  893.  
  894.  
  895.  
  896.  
  897. {******************************************************************************
  898.                            --- Dos Interrupt ---
  899. ******************************************************************************}
  900.  
  901. (*Procedure Intr (intno: byte; var regs: registers);
  902.   Begin
  903.   { Does not apply to Linux - not implemented }
  904.   End;*)
  905.  
  906.  
  907. Procedure SwapVectors;
  908.   Begin
  909.   { Does not apply to Linux - Do Nothing }
  910.   End;
  911.  
  912.  
  913. (*Procedure msdos(var regs : registers);
  914.   Begin
  915.   { ! Not implemented in Linux ! }
  916.   End;*)
  917.  
  918.  
  919. Procedure getintvec(intno : byte;var vector : pointer);
  920.   Begin
  921.   { ! Not implemented in Linux ! }
  922.   End;
  923.  
  924.  
  925. Procedure setintvec(intno : byte;vector : pointer);
  926.   Begin
  927.   { ! Not implemented in Linux ! }
  928.   End;
  929.  
  930. {******************************************************************************
  931.                         --- Info / Date / Time ---
  932. ******************************************************************************}
  933.  
  934.   Function DosVersion: Word;
  935.    var p: pLibrary;
  936.   Begin
  937.     p:=pLibrary(_DosBase);
  938.     DosVersion:= p^.lib_Version or (p^.lib_Revision shl 8);
  939.   End;
  940.  
  941. Procedure GetDate(Var Year, Month, MDay, WDay: Word);
  942. Var
  943.   cd    : pClockData;
  944.   mysec,
  945.   tick  : Longint;
  946. begin
  947.   New(cd);
  948.   CurrentTime(mysec,tick);
  949.   Amiga2Date(mysec,cd);
  950.   Year  := cd^.year;
  951.   Month := cd^.month;
  952.   MDay  := cd^.mday;
  953.   WDay  := cd^.wday;
  954.   Dispose(cd);
  955. end;
  956.  
  957. Procedure SetDate(Year, Month, Day: Word);
  958.   Begin
  959.   { !! }
  960.   End;
  961.  
  962. Procedure GetTime(Var Hour, Minute, Second, Sec100: Word);
  963. Var
  964.   mysec,
  965.   tick    : Longint;
  966.   cd      : pClockData;
  967. begin
  968.   New(cd);
  969.   CurrentTime(mysec,tick);
  970.   Amiga2Date(mysec,cd);
  971.   Hour   := cd^.hour;
  972.   Minute := cd^.min;
  973.   Second := cd^.sec;
  974.   Sec100 := 0;
  975.   Dispose(cd);
  976. END;
  977.  
  978.  
  979. Procedure SetTime(Hour, Minute, Second, Sec100: Word);
  980.   Begin
  981.   { !! }
  982.   End;
  983.  
  984. Procedure unpacktime(p : longint;var t : datetime);
  985. Begin
  986.   AmigaToDt(p,t);
  987. End;
  988.  
  989.  
  990. Procedure packtime(var t : datetime;var p : longint);
  991. Begin
  992.   p := DtToAmiga(t);
  993. end;
  994.  
  995.  
  996. {******************************************************************************
  997.                                --- Exec ---
  998. ******************************************************************************}
  999.  
  1000.  
  1001. Var
  1002.   LastDosExitCode: word;
  1003.   breakflag : Boolean;
  1004.   ver: Boolean;
  1005.  
  1006.  
  1007. Procedure Exec (Const Path: PathStr; Const ComLine: ComStr);
  1008.   var
  1009.    p : string;
  1010.    buf: array[0..255] of char;
  1011.    result : longint;
  1012.    MyLock : longint;
  1013.    i : Integer;
  1014.   Begin
  1015.    DosError := 0;
  1016.    LastdosExitCode := 0;
  1017.    p:=Path+' '+ComLine;
  1018.    { allow backslash as slash }
  1019.    for i:=1 to length(p) do
  1020.        if p[i]='\' then p[i]:='/';
  1021.    Move(p[1],buf,length(p));
  1022.    buf[Length(p)]:=#0;
  1023.    { Here we must first check if the command we wish to execute }
  1024.    { actually exists, because this is NOT handled by the        }
  1025.    { _SystemTagList call (program will abort!!)                 }
  1026.  
  1027.    { Try to open with shared lock                               }
  1028.    MyLock:=Lock(path,SHARED_LOCK);
  1029.    if MyLock <> 0 then
  1030.      Begin
  1031.         { File exists - therefore unlock it }
  1032.         Unlock(MyLock);
  1033.         result:=_Execute(buf);
  1034.         { on return of -1 the shell could not be executed }
  1035.         { probably because there was not enough memory    }
  1036.         if result = -1 then
  1037.           DosError:=8
  1038.         else
  1039.           LastDosExitCode:=word(result);
  1040.      end
  1041.    else
  1042.     DosError:=3;
  1043.   End;
  1044.  
  1045.  
  1046. Function DosExitCode: Word;
  1047.   Begin
  1048.     DosExitCode:=LastdosExitCode;
  1049.   End;
  1050.  
  1051.  
  1052.   Procedure GetCBreak(Var BreakValue: Boolean);
  1053.   Begin
  1054.    breakvalue:=breakflag;
  1055.   End;
  1056.  
  1057.  
  1058.  Procedure SetCBreak(BreakValue: Boolean);
  1059.   Begin
  1060.    breakflag:=BreakValue;
  1061.   End;
  1062.  
  1063.  
  1064.   Procedure GetVerify(Var Verify: Boolean);
  1065.    Begin
  1066.      verify:=ver;
  1067.    End;
  1068.  
  1069.  
  1070.  Procedure SetVerify(Verify: Boolean);
  1071.   Begin
  1072.     ver:=Verify;
  1073.   End;
  1074.  
  1075. {******************************************************************************
  1076.                                --- Disk ---
  1077. ******************************************************************************}
  1078.  
  1079. { How to solve the problem with this:       }
  1080. {  We could walk through the device list    }
  1081. {  at startup to determine possible devices }
  1082.  
  1083. const
  1084.  
  1085.   not_to_use_devs : array[0..12] of string =(
  1086.                    'DF0:',
  1087.                    'DF1:',
  1088.                    'DF2:',
  1089.                    'DF3:',
  1090.                    'PED:',
  1091.                    'PRJ:',
  1092.                    'PIPE:',
  1093.                    'RAM:',
  1094.                    'CON:',
  1095.                    'RAW:',
  1096.                    'SER:',
  1097.                    'PAR:',
  1098.                    'PRT:');
  1099.  
  1100. var
  1101.    deviceids : array[1..20] of byte;
  1102.    devicenames : array[1..20] of string[20];
  1103.    numberofdevices : Byte;
  1104.  
  1105. Function DiskFree(Drive: Byte): Longint;
  1106. Var
  1107.   MyLock      : BPTR;
  1108.   Inf         : pInfoData;
  1109.   Free        : Longint;
  1110.   myproc      : pProcess;
  1111.   OldWinPtr   : Pointer;
  1112. Begin
  1113.   Free := -1;
  1114.   { Here we stop systemrequesters to appear }
  1115.   myproc := pProcess(FindTask(nil));
  1116.   OldWinPtr := myproc^.pr_WindowPtr;
  1117.   myproc^.pr_WindowPtr := Pointer(-1);
  1118.   { End of systemrequesterstop }
  1119.   New(Inf);
  1120.   MyLock := Lock(devicenames[deviceids[Drive]],SHARED_LOCK);
  1121.   If MyLock <> 0 then begin
  1122.      if Info(MyLock,Inf) then begin
  1123.         Free := (Inf^.id_NumBlocks * Inf^.id_BytesPerBlock) -
  1124.                 (Inf^.id_NumBlocksUsed * Inf^.id_BytesPerBlock);
  1125.      end;
  1126.      Unlock(MyLock);
  1127.   end;
  1128.   Dispose(Inf);
  1129.   { Restore systemrequesters }
  1130.   myproc^.pr_WindowPtr := OldWinPtr;
  1131.   diskfree := Free;
  1132. end;
  1133.  
  1134.  
  1135.  
  1136. Function DiskSize(Drive: Byte): Longint;
  1137. Var
  1138.   MyLock      : BPTR;
  1139.   Inf         : pInfoData;
  1140.   Size        : Longint;
  1141.   myproc      : pProcess;
  1142.   OldWinPtr   : Pointer;
  1143. Begin
  1144.   Size := -1;
  1145.   { Here we stop systemrequesters to appear }
  1146.   myproc := pProcess(FindTask(nil));
  1147.   OldWinPtr := myproc^.pr_WindowPtr;
  1148.   myproc^.pr_WindowPtr := Pointer(-1);
  1149.   { End of systemrequesterstop }
  1150.   New(Inf);
  1151.   MyLock := Lock(devicenames[deviceids[Drive]],SHARED_LOCK);
  1152.   If MyLock <> 0 then begin
  1153.      if Info(MyLock,Inf) then begin
  1154.         Size := (Inf^.id_NumBlocks * Inf^.id_BytesPerBlock);
  1155.      end;
  1156.      Unlock(MyLock);
  1157.   end;
  1158.   Dispose(Inf);
  1159.   { Restore systemrequesters }
  1160.   myproc^.pr_WindowPtr := OldWinPtr;
  1161.   disksize := Size;
  1162. end;
  1163.  
  1164.  
  1165.  
  1166.  
  1167. Procedure FindFirst(Path: PathStr; Attr: Word; Var f: SearchRec);
  1168. var
  1169.  buf: Array[0..255] of char;
  1170.  Anchor : pAnchorPath;
  1171.  Result : Longint;
  1172.  index : Integer;
  1173.  s     : string;
  1174.  j     : integer;
  1175. Begin
  1176.  DosError:=0;
  1177.  New(Anchor);
  1178.  {----- allow backslash as slash         -----}
  1179.  for index:=1 to length(path) do
  1180.    if path[index]='\' then path[index]:='/';
  1181.  { remove any dot characters and replace by their current }
  1182.  { directory equivalent.                                  }
  1183.  if pos('../',path) = 1 then
  1184.  { look for parent directory }
  1185.     Begin
  1186.        delete(path,1,3);
  1187.        getdir(0,s);
  1188.        j:=length(s);
  1189.        while (s[j] <> '/') AND (s[j] <> ':') AND (j > 0 ) do
  1190.          dec(j);
  1191.        if j > 0 then
  1192.          s:=copy(s,1,j);
  1193.        path:=s+path;
  1194.     end
  1195.  else
  1196.  if pos('./',path) = 1 then
  1197.  { look for current directory }
  1198.     Begin
  1199.        delete(path,1,2);
  1200.        getdir(0,s);
  1201.        if (s[length(s)] <> '/') and (s[length(s)] <> ':') then
  1202.           s:=s+'/';
  1203.        path:=s+path;
  1204.     end;
  1205.  {----- replace * by #? AmigaOs strings  -----}
  1206.  repeat
  1207.   index:= pos('*',Path);
  1208.   if index <> 0 then
  1209.    Begin
  1210.      delete(Path,index,1);
  1211.      insert('#?',Path,index);
  1212.    end;
  1213.  until index =0;
  1214.  {--------------------------------------------}
  1215.  FillChar(Anchor^,sizeof(TAnchorPath),#0);
  1216.  move(path[1],buf,length(path));
  1217.  buf[length(path)]:=#0;
  1218.  
  1219.  Result:=MatchFirst(@buf,Anchor);
  1220.  f.AnchorPtr:=Anchor;
  1221.  if Result = ERROR_NO_MORE_ENTRIES then
  1222.    DosError:=18
  1223.  else
  1224.  if Result <> 0 then
  1225.    DosError:=3;
  1226.  { If there is an error, deallocate }
  1227.  { the anchorpath structure         }
  1228.  if DosError <> 0 then
  1229.    Begin
  1230.      MatchEnd(Anchor);
  1231.      if assigned(Anchor) then
  1232.        Dispose(Anchor);
  1233.    end
  1234.  else
  1235.  {-------------------------------------------------------------------}
  1236.  { Here we fill up the SearchRec attribute, but we also do check     }
  1237.  { something else, if the it does not match the mask we are looking  }
  1238.  { for we should go to the next file or directory.                   }
  1239.  {-------------------------------------------------------------------}
  1240.    Begin
  1241.          with Anchor^.ap_Info do
  1242.           Begin
  1243.              f.Time := fib_Date.ds_Days * (24 * 60 * 60) +
  1244.              fib_Date.ds_Minute * 60 +
  1245.              fib_Date.ds_Tick div 50;
  1246.            {*------------------------------------*}
  1247.            {* Determine if is a file or a folder *}
  1248.            {*------------------------------------*}
  1249.            if fib_DirEntryType > 0 then
  1250.                f.attr:=f.attr OR DIRECTORY;
  1251.  
  1252.            {*------------------------------------*}
  1253.            {* Determine if Read only             *}
  1254.            {*  Readonly if R flag on and W flag  *}
  1255.            {*   off.                             *}
  1256.            {* Should we check also that EXEC     *}
  1257.            {* is zero? for read only?            *}
  1258.            {*------------------------------------*}
  1259.            if   ((fib_Protection and FIBF_READ) <> 0)
  1260.             AND ((fib_Protection and FIBF_WRITE) = 0)
  1261.            then
  1262.               f.attr:=f.attr or READONLY;
  1263.            f.Name := strpas(fib_FileName);
  1264.            f.Size := fib_Size;
  1265.          end; { end with }
  1266.    end;
  1267. End;
  1268.  
  1269.  
  1270. Procedure FindNext(Var f: SearchRec);
  1271. var
  1272.  Result: longint;
  1273.  Anchor : pAnchorPath;
  1274. Begin
  1275.  DosError:=0;
  1276.  Result:=MatchNext(f.AnchorPtr);
  1277.  if Result = ERROR_NO_MORE_ENTRIES then
  1278.    DosError:=18
  1279.  else
  1280.  if Result <> 0 then
  1281.    DosError:=3;
  1282.  { If there is an error, deallocate }
  1283.  { the anchorpath structure         }
  1284.  if DosError <> 0 then
  1285.    Begin
  1286.      MatchEnd(f.AnchorPtr);
  1287.      if assigned(f.AnchorPtr) then
  1288.        Dispose(f.AnchorPtr);
  1289.    end
  1290.  else
  1291.  { Fill up the Searchrec information     }
  1292.  { and also check if the files are with  }
  1293.  { the correct attributes                }
  1294.    Begin
  1295.          Anchor:=pAnchorPath(f.AnchorPtr);
  1296.          with Anchor^.ap_Info do
  1297.           Begin
  1298.              f.Time := fib_Date.ds_Days * (24 * 60 * 60) +
  1299.              fib_Date.ds_Minute * 60 +
  1300.              fib_Date.ds_Tick div 50;
  1301.            {*------------------------------------*}
  1302.            {* Determine if is a file or a folder *}
  1303.            {*------------------------------------*}
  1304.            if fib_DirEntryType > 0 then
  1305.                f.attr:=f.attr OR DIRECTORY;
  1306.  
  1307.            {*------------------------------------*}
  1308.            {* Determine if Read only             *}
  1309.            {*  Readonly if R flag on and W flag  *}
  1310.            {*   off.                             *}
  1311.            {* Should we check also that EXEC     *}
  1312.            {* is zero? for read only?            *}
  1313.            {*------------------------------------*}
  1314.            if   ((fib_Protection and FIBF_READ) <> 0)
  1315.             AND ((fib_Protection and FIBF_WRITE) = 0)
  1316.            then
  1317.               f.attr:=f.attr or READONLY;
  1318.            f.Name := strpas(fib_FileName);
  1319.            f.Size := fib_Size;
  1320.          end; { end with }
  1321.    end;
  1322. End;
  1323.  
  1324.     Procedure FindClose(Var f: SearchRec);
  1325.       begin
  1326.       end;
  1327.  
  1328. {******************************************************************************
  1329.                                --- File ---
  1330. ******************************************************************************}
  1331.  
  1332. Procedure FSplit(path: pathstr; var dir: dirstr; var name: namestr; var ext: extstr);
  1333. var
  1334.    p1,i : longint;
  1335. begin
  1336.   { allow slash as backslash }
  1337.   for i:=1 to length(path) do
  1338.    if path[i]='\' then path[i]:='/';
  1339.   { get drive name }
  1340.   p1:=pos(':',path);
  1341.   if p1>0 then
  1342.     begin
  1343.        dir:=copy(path,1,p1);
  1344.        delete(path,1,p1);
  1345.     end
  1346.   else
  1347.     dir:='';
  1348.   { split the path and the name, there are no more path informtions }
  1349.   { if path contains no backslashes                                 }
  1350.   while true do
  1351.     begin
  1352.        p1:=pos('/',path);
  1353.        if p1=0 then
  1354.          break;
  1355.        dir:=dir+copy(path,1,p1);
  1356.        delete(path,1,p1);
  1357.     end;
  1358.   { try to find out a extension }
  1359.   p1:=pos('.',path);
  1360.   if p1>0 then
  1361.     begin
  1362.        ext:=copy(path,p1,4);
  1363.        delete(path,p1,length(path)-p1+1);
  1364.     end
  1365.   else
  1366.     ext:='';
  1367.   name:=path;
  1368. end;
  1369.  
  1370.  
  1371. Function FExpand(Path: PathStr): PathStr;
  1372. var
  1373.     FLock  : BPTR;
  1374.     buffer : array[0..255] of char;
  1375.     i :integer;
  1376.     j :integer;
  1377.     temp : string;
  1378. begin
  1379.  
  1380.    { allow backslash as slash }
  1381.     for i:=1 to length(path) do
  1382.        if path[i]='\' then path[i]:='/';
  1383.  
  1384.    temp:=path;
  1385.    if pos('../',temp) = 1 then
  1386.      delete(temp,1,3);
  1387.    if pos('./',temp) = 1 then
  1388.       delete(temp,1,2);
  1389.    {First remove all references to '/./'}
  1390.     while pos('/./',temp)<>0 do
  1391.       delete(temp,pos('/./',temp),3);
  1392.    {Now remove also all references to '/../' + of course previous dirs..}
  1393.     repeat
  1394.       i:=pos('/../',temp);
  1395.       {Find the pos of the previous dir}
  1396.       if i>1 then
  1397.         begin
  1398.           j:=i-1;
  1399.           while (j>1) and (temp[j]<>'/') do
  1400.              dec (j);{temp[1] is always '/'}
  1401.           delete(temp,j,i-j+4);
  1402.         end
  1403.       else
  1404.       if i=1 then  {i=1, so we have temp='/../something', just delete '/../'}
  1405.        delete(temp,1,4);
  1406.     until i=0;
  1407.  
  1408.  
  1409.     FLock := Lock(temp,-2);
  1410.     if FLock <> 0 then begin
  1411.        if NameFromLock(FLock,buffer,255) then begin
  1412.           Unlock(FLock);
  1413.           FExpand := strpas(buffer);
  1414.        end else begin
  1415.           Unlock(FLock);
  1416.           FExpand := '';
  1417.        end;
  1418.     end else FExpand := '';
  1419. end;
  1420.  
  1421.  
  1422.    Function  fsearch(path : pathstr;dirlist : string) : pathstr;
  1423.       var
  1424.          i,p1   : longint;
  1425.          s      : searchrec;
  1426.          newdir : pathstr;
  1427.       begin
  1428.       { No wildcards allowed in these things }
  1429.          if (pos('?',path)<>0) or (pos('*',path)<>0) then
  1430.            fsearch:=''
  1431.          else
  1432.            begin
  1433.               { allow slash as backslash }
  1434.               for i:=1 to length(dirlist) do
  1435.                 if dirlist[i]='\' then dirlist[i]:='/';
  1436.               repeat
  1437.                 p1:=pos(';',dirlist);
  1438.                 if p1<>0 then
  1439.                  begin
  1440.                    newdir:=copy(dirlist,1,p1-1);
  1441.                    delete(dirlist,1,p1);
  1442.                  end
  1443.                 else
  1444.                  begin
  1445.                    newdir:=dirlist;
  1446.                    dirlist:='';
  1447.                  end;
  1448.                 if (newdir<>'') and (not (newdir[length(newdir)] in ['/',':'])) then
  1449.                  newdir:=newdir+'/';
  1450.                 findfirst(newdir+path,anyfile,s);
  1451.                 if doserror=0 then
  1452.                  newdir:=newdir+path
  1453.                 else
  1454.                  newdir:='';
  1455.               until (dirlist='') or (newdir<>'');
  1456.               fsearch:=newdir;
  1457.            end;
  1458.       end;
  1459.  
  1460.  
  1461. Procedure getftime (var f; var time : longint);
  1462. {
  1463.     This function returns a file's date and time as the number of
  1464.     seconds after January 1, 1978 that the file was created.
  1465. }
  1466. var
  1467.     FInfo : pFileInfoBlock;
  1468.     FTime : Longint;
  1469.     FLock : Longint;
  1470.     Str   : String;
  1471.     i     : integer;
  1472. begin
  1473.     DosError:=0;
  1474.     FTime := 0;
  1475.     Str := StrPas(filerec(f).name);
  1476.     for i:=1 to length(Str) do
  1477.      if str[i]='\' then str[i]:='/';
  1478.     FLock := Lock(Str, SHARED_LOCK);
  1479.     IF FLock <> 0 then begin
  1480.         New(FInfo);
  1481.         if Examine(FLock, FInfo) then begin
  1482.              with FInfo^.fib_Date do
  1483.              FTime := ds_Days * (24 * 60 * 60) +
  1484.              ds_Minute * 60 +
  1485.              ds_Tick div 50;
  1486.         end else begin
  1487.              FTime := 0;
  1488.         end;
  1489.         Unlock(FLock);
  1490.         Dispose(FInfo);
  1491.     end
  1492.     else
  1493.      DosError:=6;
  1494.     time := FTime;
  1495. end;
  1496.  
  1497.  
  1498.   Procedure setftime(var f; time : longint);
  1499.    var
  1500.     DateStamp: pDateStamp;
  1501.     Str: String;
  1502.     i: Integer;
  1503.     Days, Minutes,Ticks: longint;
  1504.     FLock: longint;
  1505.   Begin
  1506.     new(DateStamp);
  1507.     Str := StrPas(filerec(f).name);
  1508.     for i:=1 to length(Str) do
  1509.      if str[i]='\' then str[i]:='/';
  1510.     { Check first of all, if file exists }
  1511.     FLock := Lock(Str, SHARED_LOCK);
  1512.     IF FLock <> 0 then
  1513.       begin
  1514.         Unlock(FLock);
  1515.         Amiga2DateStamp(time,Days,Minutes,ticks);
  1516.         DateStamp^.ds_Days:=Days;
  1517.         DateStamp^.ds_Minute:=Minutes;
  1518.         DateStamp^.ds_Tick:=Ticks;
  1519.         if SetFileDate(Str,DateStamp) <> 0 then
  1520.             DosError:=0
  1521.         else
  1522.             DosError:=6;
  1523.       end
  1524.     else
  1525.       DosError:=2;
  1526.     if assigned(DateStamp) then Dispose(DateStamp);
  1527.   End;
  1528.  
  1529.   Procedure getfattr(var f; var attr : word);
  1530.   var
  1531.     info : pFileInfoBlock;
  1532.     MyLock : Longint;
  1533.     flags: word;
  1534.     Str: String;
  1535.     i: integer;
  1536.   Begin
  1537.     DosError:=0;
  1538.     flags:=0;
  1539.     New(info);
  1540.     Str := StrPas(filerec(f).name);
  1541.     for i:=1 to length(Str) do
  1542.      if str[i]='\' then str[i]:='/';
  1543.     { open with shared lock to check if file exists }
  1544.     MyLock:=Lock(Str,SHARED_LOCK);
  1545.     if MyLock <> 0 then
  1546.       Begin
  1547.         Examine(MyLock,info);
  1548.         {*------------------------------------*}
  1549.         {* Determine if is a file or a folder *}
  1550.         {*------------------------------------*}
  1551.         if info^.fib_DirEntryType > 0 then
  1552.              flags:=flags OR DIRECTORY;
  1553.  
  1554.         {*------------------------------------*}
  1555.         {* Determine if Read only             *}
  1556.         {*  Readonly if R flag on and W flag  *}
  1557.         {*   off.                             *}
  1558.         {* Should we check also that EXEC     *}
  1559.         {* is zero? for read only?            *}
  1560.         {*------------------------------------*}
  1561.         if   ((info^.fib_Protection and FIBF_READ) <> 0)
  1562.          AND ((info^.fib_Protection and FIBF_WRITE) = 0)
  1563.          then
  1564.           flags:=flags OR ReadOnly;
  1565.         Unlock(mylock);
  1566.       end
  1567.     else
  1568.       DosError:=3;
  1569.     attr:=flags;
  1570.     Dispose(info);
  1571.   End;
  1572.  
  1573.  
  1574. Procedure setfattr (var f;attr : word);
  1575.   var
  1576.    flags: longint;
  1577.    MyLock : longint;
  1578.    str: string;
  1579.    i: integer;
  1580.   Begin
  1581.     DosError:=0;
  1582.     flags:=FIBF_WRITE;
  1583.     { open with shared lock }
  1584.     Str := StrPas(filerec(f).name);
  1585.     for i:=1 to length(Str) do
  1586.      if str[i]='\' then str[i]:='/';
  1587.  
  1588.     MyLock:=Lock(Str,SHARED_LOCK);
  1589.  
  1590.     { By default files are read-write }
  1591.     if attr AND ReadOnly <> 0 then
  1592.       { Clear the Fibf_write flags }
  1593.       flags:=FIBF_READ;
  1594.  
  1595.  
  1596.     if MyLock <> 0 then
  1597.      Begin
  1598.        Unlock(MyLock);
  1599.        if SetProtection(Str,flags) = 0 then
  1600.          DosError:=5;
  1601.      end
  1602.     else
  1603.       DosError:=3;
  1604.   End;
  1605.  
  1606.  
  1607.  
  1608. {******************************************************************************
  1609.                              --- Environment ---
  1610. ******************************************************************************}
  1611.  
  1612.  Function EnvCount: Longint;
  1613.  { HOW TO GET THIS VALUE:                                }
  1614.  {   Each time this function is called, we look at the   }
  1615.  {   local variables in the Process structure (2.0+)     }
  1616.  {   And we also read all files in the ENV: directory    }
  1617.   Begin
  1618.   End;
  1619.  
  1620.  
  1621.  Function EnvStr(Index: Integer): String;
  1622.   Begin
  1623.     EnvStr:='';
  1624.   End;
  1625.  
  1626.  
  1627.  
  1628. function GetEnv(envvar : String): String;
  1629. var
  1630.    buffer : Pchar;
  1631.    bufarr : array[0..255] of char;
  1632.    strbuffer : array[0..255] of char;
  1633.    temp : Longint;
  1634. begin
  1635.    move(envvar[1],strbuffer,length(envvar));
  1636.    strbuffer[length(envvar)] := #0;
  1637.    buffer := @bufarr;
  1638.    temp := GetVar(strbuffer,buffer,255,$100);
  1639.    if temp = -1 then
  1640.       GetEnv := ''
  1641.    else GetEnv := StrPas(buffer);
  1642. end;
  1643.  
  1644.  
  1645. {******************************************************************************
  1646.                              --- Not Supported ---
  1647. ******************************************************************************}
  1648.  
  1649. Procedure keep(exitcode : word);
  1650.   Begin
  1651.   { ! Not implemented in Linux ! }
  1652.   End;
  1653.  
  1654. procedure AddDevice(str : String);
  1655. begin
  1656.     inc(numberofdevices);
  1657.     deviceids[numberofdevices] := numberofdevices;
  1658.     devicenames[numberofdevices] := str;
  1659. end;
  1660.  
  1661. function MakeDeviceName(str : pchar): string;
  1662. var
  1663.    temp : string[20];
  1664. begin
  1665.    temp := strpas(str);
  1666.    temp := temp + ':';
  1667.    MakeDeviceName := temp;
  1668. end;
  1669.  
  1670. function IsInDeviceList(str : string): boolean;
  1671. var
  1672.    i : byte;
  1673.    theresult : boolean;
  1674. begin
  1675.    theresult := false;
  1676.    for i := low(not_to_use_devs) to high(not_to_use_devs) do
  1677.    begin
  1678.        if str = not_to_use_devs[i] then begin
  1679.           theresult := true;
  1680.           break;
  1681.        end;
  1682.    end;
  1683.    IsInDeviceList := theresult;
  1684. end;
  1685.  
  1686.  
  1687. function BSTR2STRING(s : BSTR): pchar;
  1688. begin
  1689.     BSTR2STRING := Pointer(Longint(BADDR(s))+1);
  1690. end;
  1691.  
  1692. procedure ReadInDevices;
  1693. var
  1694.    dl : pDosList;
  1695.    temp : pchar;
  1696.    str  : string[20];
  1697. begin
  1698.    dl := LockDosList(LDF_DEVICES or LDF_READ );
  1699.    repeat
  1700.       dl := NextDosEntry(dl,LDF_DEVICES );
  1701.       if dl <> nil then begin
  1702.          temp := BSTR2STRING(dl^.dol_Name);
  1703.          str := MakeDeviceName(temp);
  1704.          if not IsInDeviceList(str) then
  1705.               AddDevice(str);
  1706.       end;
  1707.    until dl = nil;
  1708.    UnLockDosList(LDF_DEVICES or LDF_READ );
  1709. end;
  1710.  
  1711. Begin
  1712.  DosError:=0;
  1713.  ver:=TRUE;
  1714.  breakflag:=TRUE;
  1715.  numberofdevices := 0;
  1716.  AddDevice('DF0:');
  1717.  AddDevice('DF1:');
  1718.  AddDevice('DF2:');
  1719.  AddDevice('DF3:');
  1720.  ReadInDevices;
  1721. End.
  1722.  
  1723. {
  1724.   $Log: dos.pp,v $
  1725.   Revision 1.9  1998/09/14 20:20:57  carl
  1726.     * FSplit bugfix
  1727.     * Structures bugfixes by Nils Sjoholm
  1728.  
  1729.   Revision 1.8  1998/08/19 14:52:52  carl
  1730.     * SearchRec was not aligned!! so BOUM!...
  1731.  
  1732.   Revision 1.7  1998/08/17 12:30:42  carl
  1733.     * FExpand removes dot characters
  1734.     * Findfirst single/double dot expansion
  1735.     + SetFtime implemented
  1736.  
  1737.   Revision 1.6  1998/08/13 13:18:45  carl
  1738.     * FSearch bugfix
  1739.     * FSplit bugfix
  1740.     + GetFAttr,SetFAttr and GetFTime accept dos dir separators
  1741.  
  1742.   Revision 1.5  1998/08/04 13:37:10  carl
  1743.     * bugfix of findfirst, was not convberting correctl backslahes
  1744.  
  1745.        History (Nils Sjoholm):
  1746.        10.02.1998  First version for Amiga.
  1747.                    Just GetDate and GetTime.
  1748.  
  1749.        11.02.1998  Added AmigaToDt and DtToAmiga
  1750.                    Changed GetDate and GetTime to
  1751.                    use AmigaToDt and DtToAmiga.
  1752.  
  1753.                    Added DiskSize and DiskFree.
  1754.                    They are using a string as arg
  1755.                    have to try to fix that.
  1756.  
  1757.        12.02.1998  Added Fsplit and FExpand.
  1758.                    Cleaned up the unit and removed
  1759.                    stuff that was not used yet.
  1760.  
  1761.        13.02.1998  Added CToPas and PasToC and removed
  1762.                    the uses of strings.
  1763.  
  1764.        14.02.1998  Removed AmigaToDt and DtToAmiga
  1765.                    from public area.
  1766.                    Added deviceids and devicenames
  1767.                    arrays so now diskfree and disksize
  1768.                    is compatible with dos.
  1769.  
  1770.  
  1771.  
  1772. }
  1773.  
  1774.  
  1775.  
  1776.  
  1777.  
  1778.  
  1779.  
  1780.  
  1781.  
  1782.